type sexe = Femelle | Male 
type maturite  = int
type gestation = int

type ra = float
type position = Geo.point
type rv = float

type sourisAdulte =  sexe * position * ra * rv * gestation
type souriceau =  sexe * position * ra * rv * maturite
type chat =  position * ra * rv

type animal = SA of sourisAdulte | S of souriceau | C of chat

let continue = ref false


let create_liste_surface_animaux = fun liste ->
  let rec aux = fun l res -> 
    match l with
    | [] -> res
    | (SA(s,p,ra,rv,m))::end_list ->
      let circle = Geo.Circle(p,rv) in
	let c = Geo.Circle(p, (rv /. 10.0)) in
      aux end_list (res@[circle;c])
    | _ -> failwith "Pas implémenté. (create surface)"

  in aux liste []

let create_liste_surface_murs = fun liste ->
  let rec aux = fun l res -> 
    match l with
    | [] -> res
    | (p1,p2)::end_list ->
      let segment = Geo.Line(p1,p2) in
      aux end_list (res@[segment])

  in aux liste []


let souris1 = (SA(Male,{Geo.x = 0.6; Geo.y = 0.6},0.1,0.15,1))
let mur1 = {Geo.x=0.5;Geo.y=0.0},{Geo.x=0.5;Geo.y=1.0}

let liste_animaux = ref [souris1]
let liste_murs = ref [mur1]
let liste_surface = ref ((create_liste_surface_animaux !liste_animaux)@(create_liste_surface_murs !liste_murs))

let timeout = 0.5

(*************************************************************)
(* Fonctions de déplacement du jeu *)
(*************************************************************)

let random_direction max = Geo.rotateSeg {Geo.x=0.0;Geo.y=0.0} {Geo.x=0.0;Geo.y=max} (Random.float (2.0 *. Geo.pi ))

		

let croise = fun souris dir mur ->
	match souris with 
   | SA(s,p,ra,rv,m) -> 
	let trajectoire = Geo.( +| ) p dir in
	let segmur = mur in 
	let {Geo.x = a; Geo.y = b} = Geo.intersectionSegment (Geo.segment p trajectoire) segmur in
	if a = Geo.inf || b = Geo.inf
	then 
		false, {Geo.x = Geo.inf; Geo.y = Geo.inf}
	else
		true, {Geo.x = a; Geo.y = b}
   | _ -> failwith "Pas implémenté."


let destination = fun souris ->
  match souris with
  | SA(s,p,ra,rv,m) ->
    let t = random_direction ra in
    let b,inter = (croise souris t mur1) in
    if b
    then 
	let new_pos = Geo.( +| ) p ( Geo.( *| ) 0.95 (Geo.vecteur p inter)) in
	SA(s,new_pos,ra,rv,m)
    else 
    	let new_pos = Geo.( +| ) p t in
	SA(s,new_pos,ra,rv,m)
  
  | _ -> failwith "Pas implémenté (destination)" 

let rec sphere = fun liste ->
  match liste with
  | [] -> []
  | x::end_list ->
    (destination x)::(sphere end_list)






(* ********************************************************** *)
(* Fonctions d'affichage *)
(* ********************************************************** *)

let vertex {Geo.x=x; Geo.y=y} =
  GlDraw.vertex ~x ~y ()

let translate r =
  GlMat.translate ~x:r.Geo.x ~y:r.Geo.y ()

let scale s =
  GlMat.scale ~x:s ~y:s ()

let protect f g =
  try
    f();
    g()
  with e ->
    g();
    raise e;;

let mat f =
  GlMat.push();
  protect f GlMat.pop

let render prim f =
  GlDraw.begins prim;
  protect f GlDraw.ends

let circle x = Geo.point (sin x) (cos x)

let display_surface = function
  | Geo.Circle (c, r) ->
      GlMat.push();
      mat (fun () ->
        translate c;
        scale r;
        let n = 360 in
        GlDraw.begins `line_loop;
        for i=0 to n-1 do
          vertex (circle (2. *. Geo.pi *. float i /. float n))
        done;
        GlDraw.ends ())
  | Geo.Line (v1, v2) ->
      GlDraw.begins `lines;
      List.iter vertex [v1; v2];
      GlDraw.ends ()
  | Geo.Polygon (pts) ->
      GlDraw.begins `polygon;
      List.iter vertex pts;
      GlDraw.ends ()

let display () =
  GlClear.clear [ `color; `depth ];
  Gl.enable `depth_test;
  GlFunc.depth_func `lequal;
  GlMat.mode `projection;
  GlMat.load_identity ();
  GlMat.ortho ~x:(0., 1.) ~y:(0., 1.) ~z:(0., 1.);
  GlMat.mode `modelview;
  GlMat.load_identity ();
  GlDraw.color (1., 1., 1.) ~alpha:1.;
  List.iter display_surface !liste_surface;
  Gl.finish ();
  Unix.sleep 0;
  Glut.swapBuffers ()

let idle () = 
	if !continue
	then
  		liste_animaux := sphere (!liste_animaux) ;
  		liste_surface := (create_liste_surface_animaux !liste_animaux)@(create_liste_surface_murs !liste_murs);
		continue := false

let handle_key (key:int) =
	
	match key with
	| 27 -> exit 0
	| 13 -> continue := true
	| _ -> print_string "\n touche : " ; print_int key; print_char '\n'

let create_window (width:int) (height:int) (title:string) =
  ignore (Glut.init Sys.argv);
  Glut.initDisplayMode ~alpha:true ~double_buffer:true ~depth:true ();
  Glut.initWindowSize ~w:width ~h:height;
  ignore (Glut.createWindow ~title:title);
  GlClear.color (0., 0., 0.) ~alpha:0.;
  Gl.enable `blend;
  List.iter Gl.enable [`line_smooth; `polygon_smooth];
  List.iter (fun x -> GlMisc.hint x `nicest) [`line_smooth; `polygon_smooth];
  GlDraw.line_width 4.;
  GlFunc.blend_func ~src:`src_alpha ~dst:`one

let set_cb display idle (key_event:int->unit) =
  Glut.displayFunc ~cb:display;
  let idle_glut () = idle (); Glut.postRedisplay () in
  Glut.idleFunc ~cb:(Some idle_glut);
  Glut.keyboardFunc ~cb:(fun ~key ~x ~y -> key_event key)




(***********************************************************************)
(***********************************************************************)


let () = 
  Random.self_init ();
  create_window 600 600 "Le chat et la souris";
  set_cb display idle handle_key;
  Glut.mainLoop ()

(*
let s1 : Geo.segment = {Geo.x=0.0;Geo.y=0.0}, {Geo.x=1.0;Geo.y=1.0}
let s2 : Geo.segment = {Geo.x=0.5;Geo.y=0.0}, {Geo.x=0.5;Geo.y=1.0}

let {Geo.x = a; Geo.y = b} = Geo.intersectionSegment s1 s2;;

print_char '\n';
print_float a;
print_char ';';
print_float b;
print_char '\n';
*)
